home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / dbase / vpi1_330.zip / ONFIELD.PRG < prev    next >
Text File  |  1991-12-30  |  5KB  |  155 lines
  1. ***************************************************************************
  2. **  ONFIELD.PRG
  3. **  (C) Copyright 1990-92, Sub Rosa Publishing Inc.
  4. **
  5. **  A demonstration program provided to VP-Info users.
  6. **  This program may be copied freely. If it is used in commercial code,
  7. **  please credit the source, Sub Rosa Publishing Inc.
  8. **
  9. **  ONFIELD demonstrates the use of the ON FIELD command along with
  10. **  a variety of Info commands and functions.
  11. **  ONFIELD is compatible with all current versions of VP-Info.
  12. **
  13. **  The ON FIELD/ENDON structure is unique to VP-Info.
  14. **  It is hoped that this sample program will help illustrate how
  15. **  this strucure can be used.
  16. **
  17. **  Many application have the following steps in common:
  18. **    i) Accept input information - often by the screenful.
  19. **   ii) Validate the information - requesting additional or corrected
  20. **       information as required.
  21. **  iii) Process the information.
  22. **   iv) Report the results.
  23. **
  24. **  Using the ON FIELD/ENDON structure combines steps i and ii in a very
  25. **  natural way, allowing field by field verification as information
  26. **  is entered.
  27. **
  28. **  Input fields can defined by a series of @ x,y get statements, or by
  29. **  a 'painted' screen using the TEXT/ENDTEXT structure, or even 
  30. **  a combination of the two. VP-Info creats an internal GET TABLE
  31. **  listing all active input fields. Input is activated by a READ
  32. **  command. If there is an ON FIELD/ENDON structure before the READ
  33. **  statement, it is referanced as part of the READ process.
  34. **
  35. **  The GET TABLE consists of entries numbered 0 to 65. Fields 1 to 64 refer
  36. **  to the actual input fields. Field 0 refers to a set of preprocessing
  37. **  commands, while field 65 refers to a set of post-processing commands.
  38. **
  39. **  Sid Bursten and Bernie Melman
  40. ***************************************************************************
  41. * initialize variables
  42. CUSTCODE = blank(8)
  43. UNIT_WT = 5.65
  44. MIN_WT = 5.4
  45. MAX_WT = 5.85
  46. UNITS_SOLD = 0.0
  47. NET_WT = 0
  48. UNIT_PRICE = 6.48
  49. MIN_PRICE = 5.50
  50. MAX_PRICE = 8.00
  51. NET_PRICE = 0
  52. *
  53. IF :color<> 7 ; choose a color if not monochrome
  54.    SET color to 126 ; yellow on grey
  55. ENDIF
  56. ERASE; clears screen
  57. WINDOW 5,10,18,72 DOUBLE ; note no ',' before keyword DOUBLE
  58. * 'paint' text screen.
  59. TEXT
  60. .. custcode   !!!!!!!!
  61. .. unit_wt      99.999
  62. .. units_sold  999
  63. .. net_wt    99999.999
  64. .. unit_price  999.99
  65. .. net_price 99999.99
  66. .. min_price   $$9.99
  67. .. max_price   $$9.99
  68. .. min_wt      999.99
  69. .. max_wt      999.99
  70.  
  71.                       WIDGETS OF THE WORLD
  72.                    ORDER SUMMARY DEMO PROGRAM
  73.                  (Experiment with illegal values)
  74.  
  75.        UNITS SOLD: @units_sold    CUSTOMER CODE: @custcode
  76.                    MINIMUM    MAXIMUM     ACTUAL
  77.       UNIT WEIGHT: #min_wt    #max_wt     @unit_wt
  78.        UNIT PRICE: #min_price #max_price  @unit_price
  79.  
  80.            NET WEIGHT: @net_wt
  81.             NET PRICE: @net_price
  82.  
  83. ENDTEXT
  84. * declare the ON FIELD structure AFTER the input screen is displayed
  85. * but BEFORE the READ statemet that it controls
  86. ON field
  87. FIELD 0 ; field 0 commands are executed before an real field is processed
  88.    @ 19,22 say  ' Enter QUIT to exit '
  89.    :FIELD = field(custcode)
  90. FIELD custcode
  91. * customer code could be verified here - and customer file alligned
  92.    IF custcode = 'QUIT'
  93.       :FIELD = 65  ; i.e. fall out of the READ
  94.    ELSE
  95.       @ 19,22 say blank(38,205) ; rebuild double box
  96.       @ 19,22 say ' Enter Negative Value to Exit. '
  97.       :FIELD = field(units_sold)
  98.    ENDIF
  99. FIELD units_sold
  100.    DO CASE
  101.    CASE  units_sold < 0 ; user wants out
  102.       :FIELD = 65
  103.    CASE  units_sold > 300
  104.       RING
  105.       RING
  106.       @ 19,22 say blank(38,205) ; rebuild double box
  107.       @ 19,22 say " I won't believe more than 300 !!! "
  108.       :FIELD = field(units_sold)
  109.    CASE units_sold >=0 .and. units_sold < 20
  110.       RING
  111.       @ 19,22 say blank(38,205) ; rebuild double box
  112.       @ 19,22 say  ' Oh! Dissapointing sales volume !!! '
  113.       :FIELD = field(unit_wt)
  114.    CASE units_sold > 50 .and. units_sold < 300
  115.       ?? chr(7) ; RING does the same thing as this line
  116.       @ 19,22 say blank(38,205) ; rebuild double box
  117.       @ 19,22 say  ' Hey, Good Work !!! '
  118.       :FIELD = field(unit_wt)
  119.    OTHERWISE
  120.       @ 19,22 say  blank(38,205)
  121.       :FIELD = field(unit_wt)
  122.    ENDCASE
  123. FIELD unit_wt
  124.    IF unit_wt < min_wt .or. unit_wt > max_wt
  125.       ?? chr(7),chr(7)
  126.       @ 19,22 say blank(38,205) ; rebuild double box
  127.       @ 19,22 say  ' Oops, weight out of range! '
  128.       :FIELD = field(unit_wt)
  129.    ELSE
  130.       NET_WT = unit_wt * units_sold
  131.       :FIELD = field(unit_price)
  132.       @ 19,22 say blank(38,205) ; rebuild double box
  133.    ENDIF
  134. FIELD unit_price
  135.    IF unit_price < min_price .or. unit_price > max_price
  136.       RING
  137.       RING
  138.       @ 19,22 say blank(38,205) ; rebuild double box
  139.       @ 19,22 say  ' Oops, price out of range! '
  140.       :FIELD = field(unit_price)
  141.    ELSE
  142.       NET_PRICE = unit_price * units_sold
  143.       :FIELD = 65
  144.    ENDIF
  145. FIELD 65
  146.    RING
  147.    @ 19,22 say blank(38,205) ; rebuild double box
  148.    @ 19,22 say  ' Press any key to end demo. '
  149. ENDON
  150. READ
  151. DUMMY = inkey()
  152. WINDOW
  153. chain samples*
  154. *                    *** end of ONFIELD.PRG ***
  155.